home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / perl5 / perl5.002 / ext / socket / socket.xs < prev   
Encoding:
Text File  |  1996-01-23  |  12.8 KB  |  751 lines
  1. #include "EXTERN.h"
  2. #include "perl.h"
  3. #include "XSUB.h"
  4.  
  5. #ifndef VMS
  6. # ifdef I_SYS_TYPES
  7. #  include <sys/types.h>
  8. # endif
  9. #include <sys/socket.h>
  10. #ifdef I_SYS_UN
  11. #include <sys/un.h>
  12. #endif
  13. # ifdef I_NETINET_IN
  14. #  include <netinet/in.h>
  15. # endif
  16. #include <netdb.h>
  17. #include <arpa/inet.h>
  18. #else
  19. #include "sockadapt.h"
  20. #endif
  21.  
  22. #ifndef AF_NBS
  23. #undef PF_NBS
  24. #endif
  25.  
  26. #ifndef AF_X25
  27. #undef PF_X25
  28. #endif
  29.  
  30. #ifndef INADDR_NONE
  31. #define INADDR_NONE    0xffffffff
  32. #endif /* INADDR_NONE */
  33. #ifndef INADDR_LOOPBACK
  34. #define INADDR_LOOPBACK         0x7F000001
  35. #endif /* INADDR_LOOPBACK */
  36.  
  37.  
  38. static int
  39. not_here(s)
  40. char *s;
  41. {
  42.     croak("Socket::%s not implemented on this architecture", s);
  43.     return -1;
  44. }
  45.  
  46. static double
  47. constant(name, arg)
  48. char *name;
  49. int arg;
  50. {
  51.     errno = 0;
  52.     switch (*name) {
  53.     case 'A':
  54.     if (strEQ(name, "AF_802"))
  55. #ifdef AF_802
  56.         return AF_802;
  57. #else
  58.         goto not_there;
  59. #endif
  60.     if (strEQ(name, "AF_APPLETALK"))
  61. #ifdef AF_APPLETALK
  62.         return AF_APPLETALK;
  63. #else
  64.         goto not_there;
  65. #endif
  66.     if (strEQ(name, "AF_CCITT"))
  67. #ifdef AF_CCITT
  68.         return AF_CCITT;
  69. #else
  70.         goto not_there;
  71. #endif
  72.     if (strEQ(name, "AF_CHAOS"))
  73. #ifdef AF_CHAOS
  74.         return AF_CHAOS;
  75. #else
  76.         goto not_there;
  77. #endif
  78.     if (strEQ(name, "AF_DATAKIT"))
  79. #ifdef AF_DATAKIT
  80.         return AF_DATAKIT;
  81. #else
  82.         goto not_there;
  83. #endif
  84.     if (strEQ(name, "AF_DECnet"))
  85. #ifdef AF_DECnet
  86.         return AF_DECnet;
  87. #else
  88.         goto not_there;
  89. #endif
  90.     if (strEQ(name, "AF_DLI"))
  91. #ifdef AF_DLI
  92.         return AF_DLI;
  93. #else
  94.         goto not_there;
  95. #endif
  96.     if (strEQ(name, "AF_ECMA"))
  97. #ifdef AF_ECMA
  98.         return AF_ECMA;
  99. #else
  100.         goto not_there;
  101. #endif
  102.     if (strEQ(name, "AF_GOSIP"))
  103. #ifdef AF_GOSIP
  104.         return AF_GOSIP;
  105. #else
  106.         goto not_there;
  107. #endif
  108.     if (strEQ(name, "AF_HYLINK"))
  109. #ifdef AF_HYLINK
  110.         return AF_HYLINK;
  111. #else
  112.         goto not_there;
  113. #endif
  114.     if (strEQ(name, "AF_IMPLINK"))
  115. #ifdef AF_IMPLINK
  116.         return AF_IMPLINK;
  117. #else
  118.         goto not_there;
  119. #endif
  120.     if (strEQ(name, "AF_INET"))
  121. #ifdef AF_INET
  122.         return AF_INET;
  123. #else
  124.         goto not_there;
  125. #endif
  126.     if (strEQ(name, "AF_LAT"))
  127. #ifdef AF_LAT
  128.         return AF_LAT;
  129. #else
  130.         goto not_there;
  131. #endif
  132.     if (strEQ(name, "AF_MAX"))
  133. #ifdef AF_MAX
  134.         return AF_MAX;
  135. #else
  136.         goto not_there;
  137. #endif
  138.     if (strEQ(name, "AF_NBS"))
  139. #ifdef AF_NBS
  140.         return AF_NBS;
  141. #else
  142.         goto not_there;
  143. #endif
  144.     if (strEQ(name, "AF_NIT"))
  145. #ifdef AF_NIT
  146.         return AF_NIT;
  147. #else
  148.         goto not_there;
  149. #endif
  150.     if (strEQ(name, "AF_NS"))
  151. #ifdef AF_NS
  152.         return AF_NS;
  153. #else
  154.         goto not_there;
  155. #endif
  156.     if (strEQ(name, "AF_OSI"))
  157. #ifdef AF_OSI
  158.         return AF_OSI;
  159. #else
  160.         goto not_there;
  161. #endif
  162.     if (strEQ(name, "AF_OSINET"))
  163. #ifdef AF_OSINET
  164.         return AF_OSINET;
  165. #else
  166.         goto not_there;
  167. #endif
  168.     if (strEQ(name, "AF_PUP"))
  169. #ifdef AF_PUP
  170.         return AF_PUP;
  171. #else
  172.         goto not_there;
  173. #endif
  174.     if (strEQ(name, "AF_SNA"))
  175. #ifdef AF_SNA
  176.         return AF_SNA;
  177. #else
  178.         goto not_there;
  179. #endif
  180.     if (strEQ(name, "AF_UNIX"))
  181. #ifdef AF_UNIX
  182.         return AF_UNIX;
  183. #else
  184.         goto not_there;
  185. #endif
  186.     if (strEQ(name, "AF_UNSPEC"))
  187. #ifdef AF_UNSPEC
  188.         return AF_UNSPEC;
  189. #else
  190.         goto not_there;
  191. #endif
  192.     if (strEQ(name, "AF_X25"))
  193. #ifdef AF_X25
  194.         return AF_X25;
  195. #else
  196.         goto not_there;
  197. #endif
  198.     break;
  199.     case 'B':
  200.     break;
  201.     case 'C':
  202.     break;
  203.     case 'D':
  204.     break;
  205.     case 'E':
  206.     break;
  207.     case 'F':
  208.     break;
  209.     case 'G':
  210.     break;
  211.     case 'H':
  212.     break;
  213.     case 'I':
  214.     break;
  215.     case 'J':
  216.     break;
  217.     case 'K':
  218.     break;
  219.     case 'L':
  220.     break;
  221.     case 'M':
  222.     if (strEQ(name, "MSG_DONTROUTE"))
  223. #ifdef MSG_DONTROUTE
  224.         return MSG_DONTROUTE;
  225. #else
  226.         goto not_there;
  227. #endif
  228.     if (strEQ(name, "MSG_MAXIOVLEN"))
  229. #ifdef MSG_MAXIOVLEN
  230.         return MSG_MAXIOVLEN;
  231. #else
  232.         goto not_there;
  233. #endif
  234.     if (strEQ(name, "MSG_OOB"))
  235. #ifdef MSG_OOB
  236.         return MSG_OOB;
  237. #else
  238.         goto not_there;
  239. #endif
  240.     if (strEQ(name, "MSG_PEEK"))
  241. #ifdef MSG_PEEK
  242.         return MSG_PEEK;
  243. #else
  244.         goto not_there;
  245. #endif
  246.     break;
  247.     case 'N':
  248.     break;
  249.     case 'O':
  250.     break;
  251.     case 'P':
  252.     if (strEQ(name, "PF_802"))
  253. #ifdef PF_802
  254.         return PF_802;
  255. #else
  256.         goto not_there;
  257. #endif
  258.     if (strEQ(name, "PF_APPLETALK"))
  259. #ifdef PF_APPLETALK
  260.         return PF_APPLETALK;
  261. #else
  262.         goto not_there;
  263. #endif
  264.     if (strEQ(name, "PF_CCITT"))
  265. #ifdef PF_CCITT
  266.         return PF_CCITT;
  267. #else
  268.         goto not_there;
  269. #endif
  270.     if (strEQ(name, "PF_CHAOS"))
  271. #ifdef PF_CHAOS
  272.         return PF_CHAOS;
  273. #else
  274.         goto not_there;
  275. #endif
  276.     if (strEQ(name, "PF_DATAKIT"))
  277. #ifdef PF_DATAKIT
  278.         return PF_DATAKIT;
  279. #else
  280.         goto not_there;
  281. #endif
  282.     if (strEQ(name, "PF_DECnet"))
  283. #ifdef PF_DECnet
  284.         return PF_DECnet;
  285. #else
  286.         goto not_there;
  287. #endif
  288.     if (strEQ(name, "PF_DLI"))
  289. #ifdef PF_DLI
  290.         return PF_DLI;
  291. #else
  292.         goto not_there;
  293. #endif
  294.     if (strEQ(name, "PF_ECMA"))
  295. #ifdef PF_ECMA
  296.         return PF_ECMA;
  297. #else
  298.         goto not_there;
  299. #endif
  300.     if (strEQ(name, "PF_GOSIP"))
  301. #ifdef PF_GOSIP
  302.         return PF_GOSIP;
  303. #else
  304.         goto not_there;
  305. #endif
  306.     if (strEQ(name, "PF_HYLINK"))
  307. #ifdef PF_HYLINK
  308.         return PF_HYLINK;
  309. #else
  310.         goto not_there;
  311. #endif
  312.     if (strEQ(name, "PF_IMPLINK"))
  313. #ifdef PF_IMPLINK
  314.         return PF_IMPLINK;
  315. #else
  316.         goto not_there;
  317. #endif
  318.     if (strEQ(name, "PF_INET"))
  319. #ifdef PF_INET
  320.         return PF_INET;
  321. #else
  322.         goto not_there;
  323. #endif
  324.     if (strEQ(name, "PF_LAT"))
  325. #ifdef PF_LAT
  326.         return PF_LAT;
  327. #else
  328.         goto not_there;
  329. #endif
  330.     if (strEQ(name, "PF_MAX"))
  331. #ifdef PF_MAX
  332.         return PF_MAX;
  333. #else
  334.         goto not_there;
  335. #endif
  336.     if (strEQ(name, "PF_NBS"))
  337. #ifdef PF_NBS
  338.         return PF_NBS;
  339. #else
  340.         goto not_there;
  341. #endif
  342.     if (strEQ(name, "PF_NIT"))
  343. #ifdef PF_NIT
  344.         return PF_NIT;
  345. #else
  346.         goto not_there;
  347. #endif
  348.     if (strEQ(name, "PF_NS"))
  349. #ifdef PF_NS
  350.         return PF_NS;
  351. #else
  352.         goto not_there;
  353. #endif
  354.     if (strEQ(name, "PF_OSI"))
  355. #ifdef PF_OSI
  356.         return PF_OSI;
  357. #else
  358.         goto not_there;
  359. #endif
  360.     if (strEQ(name, "PF_OSINET"))
  361. #ifdef PF_OSINET
  362.         return PF_OSINET;
  363. #else
  364.         goto not_there;
  365. #endif
  366.     if (strEQ(name, "PF_PUP"))
  367. #ifdef PF_PUP
  368.         return PF_PUP;
  369. #else
  370.         goto not_there;
  371. #endif
  372.     if (strEQ(name, "PF_SNA"))
  373. #ifdef PF_SNA
  374.         return PF_SNA;
  375. #else
  376.         goto not_there;
  377. #endif
  378.     if (strEQ(name, "PF_UNIX"))
  379. #ifdef PF_UNIX
  380.         return PF_UNIX;
  381. #else
  382.         goto not_there;
  383. #endif
  384.     if (strEQ(name, "PF_UNSPEC"))
  385. #ifdef PF_UNSPEC
  386.         return PF_UNSPEC;
  387. #else
  388.         goto not_there;
  389. #endif
  390.     if (strEQ(name, "PF_X25"))
  391. #ifdef PF_X25
  392.         return PF_X25;
  393. #else
  394.         goto not_there;
  395. #endif
  396.     break;
  397.     case 'Q':
  398.     break;
  399.     case 'R':
  400.     break;
  401.     case 'S':
  402.     if (strEQ(name, "SOCK_DGRAM"))
  403. #ifdef SOCK_DGRAM
  404.         return SOCK_DGRAM;
  405. #else
  406.         goto not_there;
  407. #endif
  408.     if (strEQ(name, "SOCK_RAW"))
  409. #ifdef SOCK_RAW
  410.         return SOCK_RAW;
  411. #else
  412.         goto not_there;
  413. #endif
  414.     if (strEQ(name, "SOCK_RDM"))
  415. #ifdef SOCK_RDM
  416.         return SOCK_RDM;
  417. #else
  418.         goto not_there;
  419. #endif
  420.     if (strEQ(name, "SOCK_SEQPACKET"))
  421. #ifdef SOCK_SEQPACKET
  422.         return SOCK_SEQPACKET;
  423. #else
  424.         goto not_there;
  425. #endif
  426.     if (strEQ(name, "SOCK_STREAM"))
  427. #ifdef SOCK_STREAM
  428.         return SOCK_STREAM;
  429. #else
  430.         goto not_there;
  431. #endif
  432.     if (strEQ(name, "SOL_SOCKET"))
  433. #ifdef SOL_SOCKET
  434.         return SOL_SOCKET;
  435. #else
  436.         goto not_there;
  437. #endif
  438.     if (strEQ(name, "SOMAXCONN"))
  439. #ifdef SOMAXCONN
  440.         return SOMAXCONN;
  441. #else
  442.         goto not_there;
  443. #endif
  444.     if (strEQ(name, "SO_ACCEPTCONN"))
  445. #ifdef SO_ACCEPTCONN
  446.         return SO_ACCEPTCONN;
  447. #else
  448.         goto not_there;
  449. #endif
  450.     if (strEQ(name, "SO_BROADCAST"))
  451. #ifdef SO_BROADCAST
  452.         return SO_BROADCAST;
  453. #else
  454.         goto not_there;
  455. #endif
  456.     if (strEQ(name, "SO_DEBUG"))
  457. #ifdef SO_DEBUG
  458.         return SO_DEBUG;
  459. #else
  460.         goto not_there;
  461. #endif
  462.     if (strEQ(name, "SO_DONTLINGER"))
  463. #ifdef SO_DONTLINGER
  464.         return SO_DONTLINGER;
  465. #else
  466.         goto not_there;
  467. #endif
  468.     if (strEQ(name, "SO_DONTROUTE"))
  469. #ifdef SO_DONTROUTE
  470.         return SO_DONTROUTE;
  471. #else
  472.         goto not_there;
  473. #endif
  474.     if (strEQ(name, "SO_ERROR"))
  475. #ifdef SO_ERROR
  476.         return SO_ERROR;
  477. #else
  478.         goto not_there;
  479. #endif
  480.     if (strEQ(name, "SO_KEEPALIVE"))
  481. #ifdef SO_KEEPALIVE
  482.         return SO_KEEPALIVE;
  483. #else
  484.         goto not_there;
  485. #endif
  486.     if (strEQ(name, "SO_LINGER"))
  487. #ifdef SO_LINGER
  488.         return SO_LINGER;
  489. #else
  490.         goto not_there;
  491. #endif
  492.     if (strEQ(name, "SO_OOBINLINE"))
  493. #ifdef SO_OOBINLINE
  494.         return SO_OOBINLINE;
  495. #else
  496.         goto not_there;
  497. #endif
  498.     if (strEQ(name, "SO_RCVBUF"))
  499. #ifdef SO_RCVBUF
  500.         return SO_RCVBUF;
  501. #else
  502.         goto not_there;
  503. #endif
  504.     if (strEQ(name, "SO_RCVLOWAT"))
  505. #ifdef SO_RCVLOWAT
  506.         return SO_RCVLOWAT;
  507. #else
  508.         goto not_there;
  509. #endif
  510.     if (strEQ(name, "SO_RCVTIMEO"))
  511. #ifdef SO_RCVTIMEO
  512.         return SO_RCVTIMEO;
  513. #else
  514.         goto not_there;
  515. #endif
  516.     if (strEQ(name, "SO_REUSEADDR"))
  517. #ifdef SO_REUSEADDR
  518.         return SO_REUSEADDR;
  519. #else
  520.         goto not_there;
  521. #endif
  522.     if (strEQ(name, "SO_REUSEPORT"))
  523. #ifdef SO_REUSEPORT
  524.         return SO_REUSEPORT;
  525. #else
  526.         goto not_there;
  527. #endif
  528.     if (strEQ(name, "SO_SNDBUF"))
  529. #ifdef SO_SNDBUF
  530.         return SO_SNDBUF;
  531. #else
  532.         goto not_there;
  533. #endif
  534.     if (strEQ(name, "SO_SNDLOWAT"))
  535. #ifdef SO_SNDLOWAT
  536.         return SO_SNDLOWAT;
  537. #else
  538.         goto not_there;
  539. #endif
  540.     if (strEQ(name, "SO_SNDTIMEO"))
  541. #ifdef SO_SNDTIMEO
  542.         return SO_SNDTIMEO;
  543. #else
  544.         goto not_there;
  545. #endif
  546.     if (strEQ(name, "SO_TYPE"))
  547. #ifdef SO_TYPE
  548.         return SO_TYPE;
  549. #else
  550.         goto not_there;
  551. #endif
  552.     if (strEQ(name, "SO_USELOOPBACK"))
  553. #ifdef SO_USELOOPBACK
  554.         return SO_USELOOPBACK;
  555. #else
  556.         goto not_there;
  557. #endif
  558.     break;
  559.     case 'T':
  560.     break;
  561.     case 'U':
  562.     break;
  563.     case 'V':
  564.     break;
  565.     case 'W':
  566.     break;
  567.     case 'X':
  568.     break;
  569.     case 'Y':
  570.     break;
  571.     case 'Z':
  572.     break;
  573.     }
  574.     errno = EINVAL;
  575.     return 0;
  576.  
  577. not_there:
  578.     errno = ENOENT;
  579.     return 0;
  580. }
  581.  
  582.  
  583. MODULE = Socket        PACKAGE = Socket
  584.  
  585. double
  586. constant(name,arg)
  587.     char *        name
  588.     int        arg
  589.  
  590.  
  591. void
  592. inet_aton(host)
  593.     char *    host
  594.     CODE:
  595.     {
  596.     struct in_addr ip_address;
  597.     struct hostent * phe;
  598.  
  599.     if (phe = gethostbyname(host)) {
  600.         Copy( phe->h_addr, &ip_address, phe->h_length, char );
  601.     } else {
  602.             ip_address.s_addr = inet_addr(host);
  603.     }
  604.  
  605.     ST(0) = sv_newmortal();
  606.     if(ip_address.s_addr != INADDR_NONE) {
  607.         sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
  608.     }
  609.     }
  610.  
  611. void
  612. inet_ntoa(ip_address_sv)
  613.     SV *    ip_address_sv
  614.     CODE:
  615.     {
  616.     STRLEN addrlen;
  617.     struct in_addr addr;
  618.     char * addr_str;
  619.     char * ip_address = SvPV(ip_address_sv,addrlen);
  620.     if (addrlen != sizeof(addr)) {
  621.         croak("Bad arg length for %s, length is %d, should be %d",
  622.             "Socket::inet_ntoa",
  623.             addrlen, sizeof(addr));
  624.     }
  625.  
  626.     Copy( ip_address, &addr, sizeof addr, char );
  627.     addr_str = inet_ntoa(addr);
  628.  
  629.     ST(0) = sv_2mortal(newSVpv(addr_str, strlen(addr_str)));
  630.     }
  631.  
  632. void
  633. pack_sockaddr_un(pathname)
  634.     char *    pathname
  635.     CODE:
  636.     {
  637. #ifdef I_SYS_UN
  638.     struct sockaddr_un sun_ad; /* fear using sun */
  639.     Zero( &sun_ad, sizeof sun_ad, char );
  640.     sun_ad.sun_family = AF_UNIX;
  641.     Copy( pathname, sun_ad.sun_path, sizeof sun_ad.sun_path, char );
  642.     ST(0) = sv_2mortal(newSVpv((char *)&sun_ad, sizeof sun_ad));
  643. #else
  644.     ST(0) = (SV *) not_here("pack_sockaddr_un");
  645. #endif
  646.     
  647.     }
  648.  
  649. void
  650. unpack_sockaddr_un(sun_sv)
  651.     SV *    sun_sv
  652.     PPCODE:
  653.     {
  654. #ifdef I_SYS_UN
  655.     STRLEN sockaddrlen;
  656.     struct sockaddr_un addr;
  657.     char *    sun_ad = SvPV(sun_sv,sockaddrlen);
  658.  
  659.     if (sockaddrlen != sizeof(addr)) {
  660.         croak("Bad arg length for %s, length is %d, should be %d",
  661.             "Socket::unpack_sockaddr_un",
  662.             sockaddrlen, sizeof(addr));
  663.     }
  664.  
  665.     Copy( sun_ad, &addr, sizeof addr, char );
  666.  
  667.     if ( addr.sun_family != AF_UNIX ) {
  668.         croak("Bad address family for %s, got %d, should be %d",
  669.             "Socket::unpack_sockaddr_un",
  670.             addr.sun_family,
  671.             AF_UNIX);
  672.     } 
  673.     ST(0) = sv_2mortal(newSVpv(addr.sun_path, strlen(addr.sun_path)));
  674. #else
  675.     ST(0) = (SV *) not_here("unpack_sockaddr_un");
  676. #endif
  677.     }
  678.  
  679. void
  680. pack_sockaddr_in(port,ip_address)
  681.     unsigned short    port
  682.     char *    ip_address
  683.     CODE:
  684.     {
  685.     struct sockaddr_in sin;
  686.  
  687.     Zero( &sin, sizeof sin, char );
  688.     sin.sin_family = AF_INET;
  689.     sin.sin_port = htons(port);
  690.     Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char );
  691.  
  692.     ST(0) = sv_2mortal(newSVpv((char *)&sin, sizeof sin));
  693.     }
  694.  
  695. void
  696. unpack_sockaddr_in(sin_sv)
  697.     SV *    sin_sv
  698.     PPCODE:
  699.     {
  700.     STRLEN sockaddrlen;
  701.     struct sockaddr_in addr;
  702.     unsigned short    port;
  703.     struct in_addr    ip_address;
  704.     char *    sin = SvPV(sin_sv,sockaddrlen);
  705.     if (sockaddrlen != sizeof(addr)) {
  706.         croak("Bad arg length for %s, length is %d, should be %d",
  707.             "Socket::unpack_sockaddr_in",
  708.             sockaddrlen, sizeof(addr));
  709.     }
  710.     Copy( sin, &addr,sizeof addr, char );
  711.     if ( addr.sin_family != AF_INET ) {
  712.         croak("Bad address family for %s, got %d, should be %d",
  713.             "Socket::unpack_sockaddr_in",
  714.             addr.sin_family,
  715.             AF_INET);
  716.     } 
  717.     port = ntohs(addr.sin_port);
  718.     ip_address = addr.sin_addr;
  719.  
  720.     EXTEND(sp, 2);
  721.     PUSHs(sv_2mortal(newSViv((IV) port)));
  722.     PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)));
  723.     }
  724.  
  725. void
  726. INADDR_ANY()
  727.     CODE:
  728.     {
  729.     struct in_addr    ip_address;
  730.     ip_address.s_addr = htonl(INADDR_ANY);
  731.     ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address ));
  732.     }
  733.  
  734. void
  735. INADDR_LOOPBACK()
  736.     CODE:
  737.     {
  738.     struct in_addr    ip_address;
  739.     ip_address.s_addr = htonl(INADDR_LOOPBACK);
  740.     ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
  741.     }
  742.  
  743. void
  744. INADDR_NONE()
  745.     CODE:
  746.     {
  747.     struct in_addr    ip_address;
  748.     ip_address.s_addr = htonl(INADDR_NONE);
  749.     ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
  750.     }
  751.